home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d12
/
v9n21.arc
/
DGWRYTE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1990-11-17
|
8KB
|
237 lines
{
▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄
█ █
█ TITLE : DGWRYTE.TPU █
█ PURPOSE : Replacement for WriteLn. █
█ AUTHOR : David Gerrold, CompuServe ID: 70307,544 █
█ _____________________________________________________________________ █
█ █
█ Written in Turbo Pascal, Version 5.5, █
█ with routines from TurboPower, Object Professional. █
█ █
█ Turbo Pascal is a product of Borland International. █
█ Object Professional is a product of TurboPower Software. █
█ _____________________________________________________________________ █
█ █
█ This is not public domain software. █
█ This software is copyright 1990, by David Gerrold. █
█ Permission is hereby granted for personal use. █
█ █
█ The Brass Cannon Corporation █
█ 9420 Reseda Blvd., #804 █
█ Northridge, CA 91324-2932. █
█ █
▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
}
{ Compiler Directives ===================================================== }
{$A-} {Switch word alignment off, necessary for cloning}
{$R-} {Range checking off}
{$B-} {Boolean complete evaluation off}
{$S-} {Stack checking off}
{$I-} {I/O checking off}
{$N+,E+} {Simulate numeric coprocessor}
{$M 16384,0,327680} {stack and heap}
{$V-} {Variable range checking off}
{ Name ==================================================================== }
UNIT DgWryte;
{ Interface =============================================================== }
INTERFACE
USES
{ Object Professional Units }
OpCrt;
{ Functions and Procedures ================================================ }
FUNCTION Binary (B : byte) : string;
{ Returns string showing bits set in B. }
PROCEDURE BlankLine (Row, Attr : byte);
{ writes a blank line to screen }
PROCEDURE FastCenterAbs (S : string; Row, Attr : byte);
{ shell for FastWrite, writes centered text }
PROCEDURE FastFlushAbs (S : string; Row, Attr : byte);
{ shell for FastWrite, writes text flush right }
PROCEDURE FlushKbd;
{ Flushes the keyboard buffer, including mouse clicks. }
PROCEDURE RulerLine (Y : byte);
{ puts a ruler on line Y }
PROCEDURE Wryte (S : string);
{ shell for Write }
PROCEDURE WryteLn (S : string);
{ shell for WriteLn }
{ ========================================================================= }
{ Implementation ========================================================== }
IMPLEMENTATION
{ ========================================================================= }
{ Binary ================================================================== }
FUNCTION Binary (B : byte) : string;
{ Returns string showing bits set in B. }
VAR
Loop : byte;
Temp : string;
Ch : char;
BEGIN
Temp := '';
Loop := 128;
repeat
if
B and Loop = Loop
then
Ch := '1'
else
Ch := '0';
Temp := Temp + Ch;
Loop := Loop div 2;
until
Loop <= 0;
Binary := Temp;
END;
{ BlankLine =============================================================== }
PROCEDURE BlankLine (Row, Attr : Byte);
BEGIN
FastFill (ScreenWidth, ' ', Row, 1, Attr);
END;
{ FastFlushAbs =========================================================== }
PROCEDURE FastCenterAbs (S : string; Row, Attr : byte);
{ shell for FastWrite, writes centered text }
VAR
Len : byte absolute S;
BEGIN
FastWrite (S, Row, succ ((ScreenWidth - Len) div 2), Attr);
END;
{ FastFlushAbs =========================================================== }
PROCEDURE FastFlushAbs (S : string; Row, Attr : byte);
{ shell for FastWrite, writes text flush right }
VAR
Len : byte absolute S;
BEGIN
FastWrite (S, Row, ScreenWidth - pred (Len), Attr);
END;
{ FlushKbd ================================================================ }
PROCEDURE FlushKbd;
{ Flushes the keyboard buffer, including mouse clicks. }
VAR
I : word;
BEGIN
{$IFDEF UseMouse}
while KeyOrButtonPressed do
I := ReadKeyOrButton;
{$ELSE}
while KeyPressed do
I := ReadKeyWord;
{$ENDIF}
END;
{
Identical to FlushKeyboard in Object Professional's TPUI unit.
}
{ RulerLine =============================================================== }
PROCEDURE RulerLine (Y : byte);
{ puts a ruler on line Y }
VAR
Loop : byte;
BEGIN
For Loop := 0 to 7 do
FastWrite ('1234567890', Y, succ (Loop * 10), LightRed);
END;
{ Wryte =================================================================== }
PROCEDURE Wryte (S : string);
{
The Turbo Pascal compiler generates extra code when it compiles a
call to WriteLn. This is because WriteLn must parse both strings
and variables before it can write them. Each call to the procedure
carries the baggage of the parsing routines.
WryteLn is a shell procedure for WriteLn.
By having only one call to WriteLn in an entire program and calling
it through a shell procedure, the program will trade some speed for
code size -- but if speed is really critical, you should be using
Object Professional's FastWrite procedures instead.
Multiple variables can still be passed by concatenating them:
WryteLn ('The time is now: ' + TimeStr + '.');
}
BEGIN
Write (S);
END;
{ WryteLn ================================================================= }
PROCEDURE WryteLn (S : string);
{
The Turbo Pascal compiler generates extra code when it compiles a
call to WriteLn. This is because WriteLn must parse both strings
and variables before it can write them. Each call to the procedure
carries the baggage of the parsing routines.
WryteLn is a shell procedure for WriteLn.
By having only one call to WriteLn in an entire program and calling
it through a shell procedure, the program will trade some speed for
code size -- but if speed is really critical, you should be using
Object Professional's FastWrite procedures instead.
Multiple variables can still be passed by concatenating them:
WryteLn ('The time is now: ' + TimeStr + '.');
}
BEGIN
WriteLn (S);
END;
{ ========================================================================= }
{ Initialization ========================================================== }
{ no initialization needed }
END.
{ ========================================================================= }
{ ========================================================================= }
VERSION HISTORY:
9005.05
Started with DgWryte, BlankLine, RulerLine, and FastFlushAbs.
{ ========================================================================= }
NOTES:
{ ========================================================================= }